Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH10/SRC/SPARSE1.CLS

Text File | 1996-05-04 | 9KB | 318 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjSparseGrid"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private grid As ObjGrid3D   ' The display grid.

Private NumPts As Integer   ' # actual data values.
Private Data() As Point3D   ' Actual data values.

Private ShowData As Boolean ' Draw the actual data?

' ************************************************
' Find the data point closest to the desired
' location.
' ************************************************
Sub FindNearestPoint(x As Single, z As Single, best_i As Integer)
Dim i As Integer
Dim best_dist2 As Single
Dim diffx As Single
Dim diffz As Single
Dim dist2 As Single

    ' Start with the first data point.
    best_i = 0
    best_dist2 = 1000000

    ' See which points are closer.
    For i = 1 To NumPts
        ' See if this point is closer than the ones
        ' already chosen.
        diffx = x - Data(i).coord(1)
        diffz = z - Data(i).coord(3)
        dist2 = diffx * diffx + diffz * diffz
        If dist2 < best_dist2 Then
            best_i = i
            best_dist2 = dist2
        End If
    Next i
End Sub




' ************************************************
' Create the grid values for display.
'
' dx and dz tell how far apart to make the grid
' lines.
' ************************************************
Public Sub InitializeGrid(Dx As Single, Dz As Single)
Dim Xmin As Single
Dim Xmax As Single
Dim Zmin As Single
Dim Zmax As Single
Dim NumX As Integer
Dim NumZ As Integer
Dim wid As Single
Dim hgt As Single
Dim i As Integer
Dim j As Integer
Dim x As Single
Dim y As Single
Dim z As Single
Dim best_i As Integer

    ' Find the X and Z data bounds.
    Xmin = Data(1).coord(1)
    Xmax = Xmin
    Zmin = Data(1).coord(3)
    Zmax = Zmin
    For i = 2 To NumPts
        If Xmin > Data(i).coord(1) Then Xmin = Data(i).coord(1)
        If Xmax < Data(i).coord(1) Then Xmax = Data(i).coord(1)
        If Zmin > Data(i).coord(3) Then Zmin = Data(i).coord(3)
        If Zmax < Data(i).coord(3) Then Zmax = Data(i).coord(3)
    Next i

    ' Set the data boundaries.
    wid = Xmax - Xmin
    hgt = Zmax - Zmin
    NumX = wid / Dx + 1
    NumZ = hgt / Dz + 1
    x = (wid - NumX * Dx) / 2
    z = (hgt - NumZ * Dz) / 2
    Xmin = Xmin - x
    Xmax = Xmax + x
    Zmin = Zmin - z
    Zmax = Zmax + z

    ' Create the new grid object.
    Set grid = New ObjGrid3D
    grid.SetBounds Xmin, Dx, NumX, Zmin, Dz, NumZ

    ' Fill in data values.
    x = Xmin
    For i = 1 To NumX
        z = Zmin
        For j = 1 To NumZ
            ' Find the closest data value.
            FindNearestPoint x, z, best_i

            ' Add the value to the grid.
            grid.SetValue x, Data(best_i).coord(2), z
            z = z + Dz
        Next j
        x = x + Dx
    Next i
End Sub


' ************************************************
' Set a data value.
' ************************************************
Sub SetValue(x As Single, y As Single, z As Single)
    NumPts = NumPts + 1
    ReDim Preserve Data(1 To NumPts)
    Data(NumPts).coord(1) = x
    Data(NumPts).coord(2) = y
    Data(NumPts).coord(3) = z
    Data(NumPts).coord(4) = 1#
End Sub
' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "SPARSE_GRID"
End Property



' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer

    ' Fix the grid points if the grid exists.
    If Not grid Is Nothing Then grid.FixPoints

    ' Fix the original data.
    For i = 1 To NumPts
        For j = 1 To 3
            Data(i).coord(j) = Data(i).trans(j)
        Next j
    Next i
End Sub

' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer

    ' Apply the matrix to the grid if it exists.
    If Not grid Is Nothing Then grid.ApplyFull M

    ' Apply the matrix to the sparse data.
    For i = 1 To NumPts
        m3ApplyFull Data(i).coord, M, Data(i).trans
    Next i
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer

    ' Apply the matrix to the grid if it exists.
    If Not grid Is Nothing Then grid.Apply M

    ' Apply the matrix to the sparse data.
    For i = 1 To NumPts
        m3Apply Data(i).coord, M, Data(i).trans
    Next i
End Sub


' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer

    ' Distort the grid if it exists.
    If Not grid Is Nothing Then grid.Distort D

    ' Distort the sparse data.
    For i = 1 To NumPts
        D.Distort Data(i).coord(1), Data(i).coord(2), Data(i).coord(3)
    Next i
End Sub

' ************************************************
' Write the sparse grid's grid object to a file
' using Write. The data can later be loaded into
' an ObjGrid3D object but not an ObjSparseGrid
' object.
' ************************************************
Public Sub FileWriteGrid(filenum As Integer)
    If Not grid Is Nothing Then grid.FileWrite filenum
End Sub



' ************************************************
' Write a sparse grid to a file using Write.
' Begin with "SPARSE_GRID" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer

    ' Write basic information.
    Write #filenum, "SPARSE_GRID", NumPts

    ' Write the data.
    For i = 1 To NumPts
        Write #filenum, Data(i).coord(1), _
            Data(i).coord(2), Data(i).coord(3)
    Next i

    ' Write grid spacing information.
    If grid Is Nothing Then
        Write #filenum, 0, 0
    Else
        Write #filenum, grid.DeltaX, grid.DeltaZ
    End If
End Sub




' ************************************************
' Draw the transformed points on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional R As Variant)
Dim i As Integer

    ' Draw the grid if it exists.
    If Not grid Is Nothing Then grid.Draw canvas, R

    ' Draw the original data points if desired.
    If ShowData Then
        On Error Resume Next
        For i = 1 To NumPts
            canvas.Line (Data(i).trans(1) - 2, Data(i).trans(2) - 2)-Step(4, 4), vbRed
            canvas.Line (Data(i).trans(1) + 2, Data(i).trans(2) - 2)-Step(-4, 4), vbRed
        Next i
    End If
End Sub


' ************************************************
' Read a sparse grid from a file using Input.
' Assume the "SPARSE_GRID" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer
Dim Dx As Single
Dim Dz As Single

    ' Get the basic information.
    Input #filenum, NumPts

    ' Allocate the Data array.
    ReDim Data(1 To NumPts)

    ' Read the data.
    For i = 1 To NumPts
        Input #filenum, Data(i).coord(1), _
            Data(i).coord(2), Data(i).coord(3)
    Next i

    ' Read grid spacing information.
    Input #filenum, Dx, Dz

    ' Initialize the grid data.
    If Dx = 0 Then
        Set grid = Nothing
    Else
        InitializeGrid Dx, Dz
    End If
End Sub


' ************************************************
' Tell the user whether we're drawing the data.
' ************************************************
Property Get ShowTrueData() As Boolean
    ShowTrueData = ShowData
End Property

' ************************************************
' Let the user decide whether we should draw the
' actual data.
' ************************************************
Property Let ShowTrueData(value As Boolean)
    ShowData = value
End Property


Private Sub Class_Initialize()
    Set grid = Nothing
End Sub